home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / VISIMP.ZIP / OMRULIST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-09  |  9KB  |  309 lines
  1. { *************************************************************************** }
  2. {                  V I S U A L  I M P L E M E N T A T I O N                   }
  3. {                                  Part One                                   }
  4. {                        Most Recently Used File List                         }
  5. {                   Pascal Version (C)1993 Bobby R. Wallen                    }
  6. {                            All Rights Reserved                              }
  7. {               Please do not remove my Credits from this file.               }
  8. { *************************************************************************** }
  9. unit OMRUList;
  10. interface
  11. uses WinTypes, Objects;
  12.  
  13. const
  14.      { Allow for up to nine (9) Remembered Files }
  15.      CM_File1 = 5000;
  16.      CM_File2 = 5001;
  17.      CM_File3 = 5002;
  18.      CM_File4 = 5003;
  19.      CM_File5 = 5004;
  20.      CM_File6 = 5005;
  21.      CM_File7 = 5006;
  22.      CM_File8 = 5007;
  23.      CM_File9 = 5008;
  24.  
  25.      { Initialized ( Static ) variable/Constants }
  26.      nMaxItems : Integer = 5;        { Default Number if Items in List }
  27.      hMDIWnd   : HWND = 0;           { MDI Client Window Handle }
  28.      DefIni    : PChar = 'WIN.INI';
  29.      DefKey    : PChar = 'files';
  30.      cFile     : Integer = 0;    { Number of remembered files }
  31.      cFileList : Integer = 0;    { Number of files in FileMenu List }
  32.  
  33. type
  34.     TItemFmt = record
  35.       ID : Integer;
  36.       Name : PChar;
  37.     end;
  38.  
  39.     PMRUItem = ^TMRUItem;
  40.     TMRUItem = object( TObject )
  41.       ItemName : PChar;
  42.       constructor Init( AName: PChar );
  43.       destructor  Done; virtual;
  44.     end;
  45.  
  46.     PMRUList = ^TMRUList;
  47.     TMRUList = object( TCollection )
  48.       constructor Init(CWnd: HWND; ALimit, ADelta: Integer );
  49.       destructor  Done; virtual;
  50.       procedure AddMRUItem( AWnd: HWND; AName: PChar ); virtual;
  51.       procedure DeleteMRUItem( AWnd: HWND; AName: PChar ); virtual;
  52.       function  GetMRUItem( AnID: Integer; AName: PChar ): Boolean; virtual;
  53.       procedure AppendMRUList( AWnd: HWND ); virtual;
  54.       procedure UpdateMRUList( AWnd: HWND ); virtual;
  55.       procedure LoadMRUList( AWnd: HWND; IniFile, KeyName: PChar ); virtual;
  56.       procedure SaveMRUList( IniFile, KeyName: PChar ); virtual;
  57.     end;
  58.  
  59. implementation
  60. uses WinProcs, Strings;
  61.  
  62. function Min( I, J: Integer ): Integer;
  63. begin
  64.      if I < J then Min := I else Min := J;
  65. end;
  66.  
  67. constructor TMRUItem.Init( AName: PChar );
  68. begin
  69.      ItemName := StrNew( AName );
  70. end;
  71.  
  72. destructor TMRUItem.Done;
  73. begin
  74.      StrDispose( ItemName );
  75. end;
  76.  
  77. constructor TMRUList.Init( CWnd: HWND; ALimit, ADelta: Integer );
  78. begin
  79.      if CWnd <> 0 then hMDIWnd := CWnd;
  80.      if ALimit > 9 then nMaxItems := 9;
  81.      if ALimit < 1 then nMaxItems := 1;
  82.      if ( ALimit >= 1 ) and ( ALimit <= 9 ) then nMaxItems := ALimit;
  83.      if ADelta <> 0 then ADelta := 0;
  84.      inherited Init( ALimit, ADelta );
  85. end;
  86.  
  87. destructor TMRUList.Done;
  88. begin
  89.      inherited Done;
  90. end;
  91.  
  92. function Check( C: PMRUList; AName: PChar ): Boolean;
  93.           function Match( I : PMRUItem ): Boolean; far;
  94.           begin
  95.                Match := StrPos( I^.ItemName, AName ) <> nil;
  96.           end;
  97.  
  98. var
  99.    F : PMRUItem;
  100. begin
  101.      F := C^.FirstThat( @Match );
  102.      if F = nil then Check := False
  103.      else
  104.      begin
  105.           Check := True;
  106.           C^.Delete( F );
  107.      end;
  108. end;
  109.  
  110. procedure TMRUList.AddMRUItem( AWnd: HWND; AName: PChar );
  111. var
  112.    P : PMRUItem;
  113.    F : Boolean;
  114. begin
  115.      F := Check( @Self, AName );
  116.      P := new( PMRUItem, Init( AName ) );
  117.      if not F then { Not in List }
  118.      begin
  119.           if Count < nMaxItems then AtInsert( 0, P )
  120.           else
  121.               begin
  122.                    AtDelete( Count - 1 );
  123.                    dec( cFile );
  124.                    AtInsert( 0, P );
  125.               end;
  126.      end
  127.      else
  128.          begin
  129.               dec( cFile );
  130.               AtInsert( 0, P );
  131.          end;
  132.      inc( cFile );
  133.      UpdateMRUList( AWnd );
  134. end;
  135.  
  136. procedure TMRUList.UpdateMRUList( AWnd: HWND );
  137. var
  138.    C      : Integer;
  139.    sz     : array[0..160] of Char;
  140.    MMenu  : HMenu;
  141.    FMenu  : HMenu;
  142.    cCount : Integer;
  143.    nFile  : Integer;
  144.    Fmt    : TItemFmt;
  145. begin
  146.      nFile := 0;
  147.      if hMDIWnd <> 0 then
  148.         if HIWORD( SendMessage( hMDIWnd, WM_MDIGETACTIVE, 0, LongInt(0))) = 1
  149.         then
  150.            inc( nFile );
  151.      MMenu := GetMenu( AWnd );
  152.      FMenu := GetSubMenu( MMenu, nFile );
  153.      cCount := GetMenuItemCount( FMenu );
  154.      dec( cCount );
  155.      for C := 0 to Min( cFile, cFileList ) - 1 do
  156.      begin
  157.           Fmt.ID := C + 1;
  158.           Fmt.Name := PMRUItem( At(C) )^.ItemName;
  159.           wvsprintf( sz, '&%d %s', Fmt );
  160.           ModifyMenu( FMenu, CM_File1 + C, MF_STRING, CM_File1 + C, sz );
  161.      end;
  162.  
  163.      if cFileList < cFile then
  164.      begin
  165.           if cFileList = 0 then
  166.              InsertMenu( FMenu, cCount, MF_SEPARATOR or MF_BYPOSITION, 0, nil )
  167.           else
  168.               dec( cCount );
  169.           for C := cFileList to cFile - 1 do
  170.           begin
  171.                Fmt.ID := C + 1;
  172.                Fmt.Name := PMRUItem( At( C ) )^.ItemName;
  173.                wvsprintf( sz, '&%d %s', Fmt );
  174.                InsertMenu( FMenu, cCount, MF_STRING or MF_BYPOSITION,
  175.                            CM_File1 + C, sz );
  176.                inc( cCount );
  177.           end;
  178.      end
  179.      else
  180.          for C := cFile to cFileList - 1 do
  181.              DeleteMenu( FMenu, CM_File1 + C, MF_BYCOMMAND );
  182.  
  183.      if (cFileList > 0) and (cFile = 0) then
  184.      begin
  185.           cCount := GetMenuItemCount( FMenu );
  186.           dec( cCount, 2 );
  187.           DeleteMenu( FMenu, cCount, MF_BYPOSITION );
  188.      end;
  189.      cFileList := cFile;
  190.      DrawMenuBar( AWnd );
  191. end;
  192.  
  193. function FindItem( C: PMRUList; AName: PChar ): Integer;
  194.          function FoundIt( P: PMRUItem ): Boolean; far;
  195.          begin
  196.               FoundIt := StrPos( P^.ItemName, AName ) <> nil;
  197.          end;
  198. var
  199.    F : PMRUItem;
  200. begin
  201.      F := C^.FirstThat( @FoundIt );
  202.      if F = nil then FindItem := -1
  203.      else
  204.      begin
  205.           C^.Delete(F);
  206.           FindItem := 0;
  207.      end;
  208. end;
  209.  
  210. procedure TMRUList.DeleteMRUItem( AWnd: HWND; AName: PChar );
  211. var
  212.    X : Integer;
  213. begin
  214.      X := FindItem( @Self, AName );
  215.      if X = -1 then Exit
  216.      else dec( cFile );
  217.      UpdateMRUList( AWnd );
  218. end;
  219.  
  220. function TMRUList.GetMRUItem( AnID: Integer; AName: PChar ): Boolean;
  221. begin
  222.      if ( AnID - CM_File1 ) < cFile then
  223.         StrCopy( AName, PMRUItem( At(AnID - CM_File1) )^.ItemName )
  224.      else
  225.          AName[0] := #0;
  226.      GetMRUItem := ( AName[0] <> #0 );
  227. end;
  228.  
  229.  
  230. procedure TMRUList.AppendMRUList( AWnd: HWND );
  231. var
  232.    C : Integer;
  233.    nFile : Integer;
  234.    cCount : Integer;
  235.    MMenu : HMenu;
  236.    FMenu : HMenu;
  237.    sz : array[0..160] of Char;
  238.    Fmt : TItemFmt;
  239. begin
  240.      nFile := 0;
  241.      if hMDIWnd <> 0 then
  242.         if HIWORD( SendMessage( hMDIWnd, WM_MDIGETACTIVE, 0, LongInt(0))) = 1
  243.         then
  244.            inc( nFile );
  245.      MMenu := GetMenu( AWnd );
  246.      FMenu := GetSubMenu( MMenu, nFile );
  247.      cCount := GetMenuItemCount( FMenu );
  248.      dec( cCount );
  249.      for C := 0 to cFile -1 do
  250.      begin
  251.           Fmt.ID := C + 1;
  252.           Fmt.Name := PMRUItem( At(C) )^.ItemName;
  253.           wvsprintf( sz, '&%d %s', Fmt );
  254.           InsertMenu( FMenu, cCount, MF_STRING or MF_BYPOSITION,
  255.                       CM_File1 + C, sz );
  256.           inc( cCount );
  257.      end;
  258.      InsertMenu( FMenu, cCount, MF_SEPARATOR or MF_BYPOSITION, 0, nil );
  259.      cFileList := cFile;
  260. end;
  261.  
  262. procedure TMRUList.LoadMRUList( AWnd: HWND; IniFile, KeyName: PChar );
  263. var
  264.    C : Integer;
  265.    sz : array[0..144] of Char;
  266.    sz2 : array[0..6] of Char;
  267.    szIniFile : array[0..144] of Char;
  268.    szKey     : array[0..144] of Char;
  269.    TheID     : Integer;
  270. begin
  271.      if IniFile[0] = #0 then StrCopy( szIniFile, DefIni )
  272.         else StrCopy(szIniFile, IniFile );
  273.      if KeyName[0] = #0 then StrCopy( szKey,DefKey)
  274.         else StrCopy( szKey, KeyName);
  275.      for C := nMaxItems - 1 downto 0 do
  276.      begin
  277.           TheID := C + 1;
  278.           wvs